home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / Pascal / Snippets / PNL Libraries / MySaveableWindow.p < prev    next >
Text File  |  1996-05-29  |  3KB  |  135 lines
  1. unit MySaveableWindow;
  2.  
  3. interface
  4.  
  5.     uses
  6.         OOMainLoop;
  7.  
  8.     type
  9.         SaveableWindowObject = object(DObject)
  10.                 spec: FSSpec;
  11.                 named: boolean;
  12.                 has_been_modified: boolean; { Either set this, or override Modified }
  13.                 function Modified: boolean;
  14.                 procedure Create (id: integer);
  15.                 override;
  16.                 procedure DoClose;
  17.                 override;
  18.                 procedure BaseNew;
  19.                 procedure BaseOpen (fs: FSSpec);
  20.                 procedure BaseSave;
  21.                 procedure SaveAs (fs: FSSpec);
  22.                 procedure DoOpen;
  23.                 procedure DoSave;
  24.                 procedure DoSaveAs;
  25.             end;
  26.  
  27. implementation
  28.  
  29.     uses
  30.         MyUtils, BaseGlobals, MyTypes, MyUtilities, MyStandardFile;
  31.  
  32.     function SaveableWindowObject.Modified: boolean;
  33.     begin
  34.         Modified := has_been_modified;
  35.     end;
  36.  
  37.     procedure SaveableWindowObject.Create (id: integer);
  38.         var
  39.             tempname: Str63;
  40.     begin
  41.         inherited Create(id);
  42.         spec.vRefNum := 1;
  43.         spec.parID := -1;
  44.         spec.name := GetGlobalString(untitled_name);
  45.         named := false;
  46.         has_been_modified := false;
  47.         tempname := spec.name;
  48.         SetWTitle(window, tempname);
  49.     end;
  50.  
  51.     procedure SaveableWindowObject.BaseNew;
  52.     begin
  53.     end;
  54.  
  55.     procedure SaveableWindowObject.BaseOpen (fs: FSSpec);
  56.     begin
  57.     end;
  58.  
  59.     procedure SaveableWindowObject.BaseSave;
  60.     begin
  61.     end;
  62.  
  63.     procedure SaveableWindowObject.BaseOpenAs;
  64.         var
  65.             reply: MySFReply;
  66.             fs: FSSpec;
  67.     begin
  68.         GetFile1('TEXT', reply);
  69.         with reply do
  70.             if Rgood then begin
  71.                 fs.vRefNum := RVRefNum;
  72.                 fs.parID := RdirID;
  73.                 fs.name := Rfname;
  74.                 BaseOpen(fs);
  75.             end
  76.             else
  77.                 Destroy;
  78.     end;
  79.  
  80.     procedure SaveableWindowObject.SaveAs (fs: FSSpec);
  81.     begin
  82.         spec := fs;
  83.         named := true;
  84.         SetWTitle(window, fs.name);
  85.         BaseSave;
  86.     end;
  87.  
  88.     procedure SaveableWindowObject.DoClose;
  89.         var
  90.             sc: SCType;
  91.     begin
  92.         sc := SCDiscard;
  93.         if Modified then begin
  94.             sc := SaveChanges;
  95.             if sc = SCSave then begin
  96.                 DoSave;
  97.                 if Modified then
  98.                     sc := SCCancel; { if still modified, then the user didn't save, so they must have canceled }
  99.             end;
  100.         end;
  101.         if sc <> SCCancel then
  102.             Destroy;
  103.     end;
  104.  
  105.     procedure SaveableWindowObject.DoSave;
  106.     begin
  107.         if not named then begin
  108.             DoSaveAs;
  109.         end
  110.         else begin
  111.             BaseSave;
  112.         end;
  113.     end;
  114.  
  115.     procedure SaveableWindowObject.DoSaveAs;
  116.         var
  117.             reply: MySFReply;
  118.             tempname: Str63;
  119.             fs: FSSpec;
  120.     begin
  121.         if named then
  122.             SetSFFile(spec.vRefNum, spec.parID);
  123.         tempname := spec.name;
  124.         PutFile('Save file as:', tempname, reply);
  125.         with reply do begin
  126.             if Rgood then begin
  127.                 fs.vRefNum := RVRefNum;
  128.                 fs.parID := RdirID;
  129.                 fs.name := Rfname;
  130.                 SaveAs(fs);
  131.             end;
  132.         end;
  133.     end;
  134.  
  135. end.